Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap09/howto02/delphi10/cciccfrm.pas

Pascal/Delphi Source File | 1996-06-11 | 21.8 KB | 632 lines

unit Cciccfrm;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl,
  {Winsock,} CCWSock, CCICCInf, CCICCPrf, IniFiles, Gauges;

type
  { This record holds the information for a number of internet connections }
  PConnectionsRecord = ^TConnectionsRecord;
  TConnectionsRecord = record
    CProfile   : string; { Connection profile; used in lists }
    CIPAddress : string; { Dotted character IP Address       }
    CUserName  : string; { Login name to site; can be anonym }
    CPassword  : string; { Password; won't be shown          }
    CStartDir  : string; { Starting directory; used for FTP  }
  end;
  { Array of TCR }
  CRFile = file of TConnectionsRecord; { File type for TCRec }
  TCCINetCCForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    ListBox1: TListBox;
    Panel7: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ListBox2: TListBox;
    ComboBox1: TComboBox;
    Button1: TButton;
    Memo1: TMemo;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Panel8: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ComboBox3: TComboBox;
    Label4: TLabel;
    Label5: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PrintDialog1: TPrintDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    Gauge1: TGauge;
    MainMenu1: TMainMenu;
    Network1: TMenuItem;
    ViewWinsockInfo1: TMenuItem;
    Description1: TMenuItem;
    SystemStatus1: TMenuItem;
    VendorSpecific1: TMenuItem;
    N1: TMenuItem;
    ProgressInfo1: TMenuItem;
    ViewInEditWindow1: TMenuItem;
    ViewInStatusLine1: TMenuItem;
    SaveToFile1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    Services1: TMenuItem;
    IPAddress1: TMenuItem;
    EMail1: TMenuItem;
    FTP1: TMenuItem;
    UsenetNws1: TMenuItem;
    Files1: TMenuItem;
    Load1: TMenuItem;
    Save1: TMenuItem;
    Encoding1: TMenuItem;
    UUDecode1: TMenuItem;
    MIMEDecode1: TMenuItem;
    UUEncode1: TMenuItem;
    MIMEEncode1: TMenuItem;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    CopytoFile1: TMenuItem;
    Paste1: TMenuItem;
    PastefromFile1: TMenuItem;
    EMail2: TMenuItem;
    CheckMail1: TMenuItem;
    CreateNewMessage1: TMenuItem;
    ReplyToCurrentMessage1: TMenuItem;
    SendCurrentMessage1: TMenuItem;
    SendQueue1: TMenuItem;
    MailServers1: TMenuItem;
    Mailboxes1: TMenuItem;
    Correspondents1: TMenuItem;
    TrashMarkedMessages1: TMenuItem;
    EmptyTrash1: TMenuItem;
    ExitEMailRequired1: TMenuItem;
    FTP2: TMenuItem;
    ConnectToSite1: TMenuItem;
    Disconnect1: TMenuItem;
    UploadMarked1: TMenuItem;
    ASCII1: TMenuItem;
    Binary1: TMenuItem;
    DownloadMarked1: TMenuItem;
    ASCII2: TMenuItem;
    ToFile1: TMenuItem;
    ToDisplay1: TMenuItem;
    Binary2: TMenuItem;
    Directory1: TMenuItem;
    ViewRemoteasText1: TMenuItem;
    ViewasText1: TMenuItem;
    Change1: TMenuItem;
    Create1: TMenuItem;
    Delete3: TMenuItem;
    ChangeLocal1: TMenuItem;
    DeleteRemoteFiles1: TMenuItem;
    FTPSites1: TMenuItem;
    News1: TMenuItem;
    ConnectandUpdate1: TMenuItem;
    Disconnect2: TMenuItem;
    Headers1: TMenuItem;
    RetrieveMarked1: TMenuItem;
    RetrieveAll1: TMenuItem;
    CheckNewNews1: TMenuItem;
    GetMarked1: TMenuItem;
    Article1: TMenuItem;
    NewArticle1: TMenuItem;
    FollowupArticle1: TMenuItem;
    PutinQueue1: TMenuItem;
    Post1: TMenuItem;
    CurrentArticle1: TMenuItem;
    EntireQueue1: TMenuItem;
    NewsServers1: TMenuItem;
    SubscribedNewsgroups1: TMenuItem;
    Trash1: TMenuItem;
    AllReadArticles1: TMenuItem;
    AllMarkedArticles1: TMenuItem;
    AllAvailableArticles1: TMenuItem;
    DownloadActiveNewsgroups1: TMenuItem;
    Preferences1: TMenuItem;
    EMail3: TMenuItem;
    FTP3: TMenuItem;
    News2: TMenuItem;
    Paths1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Description1Click(Sender: TObject);
    procedure SystemStatus1Click(Sender: TObject);
    procedure VendorSpecific1Click(Sender: TObject);
    procedure ViewInEditWindow1Click(Sender: TObject);
    procedure ViewInStatusLine1Click(Sender: TObject);
    procedure SaveToFile1Click(Sender: TObject);
    procedure IPAddress1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ReadIniData;
    procedure WriteIniData;
    procedure AddNullTermTextToMemo( TheTextToAdd   : string;
                                     TheMemoToAddTo : TMemo   );
    function AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
    procedure AddProgressText( WhatText : string );
    procedure ShowProgressText( WhatText : string );
    procedure ShowProgressErrorText( WhatText : string );
    procedure SocketsErrorOccurred( Sender     : TObject;
                                     ErrorCode  : Integer;
                                     TheMessage : string   );
  end;

const
  POV_MEMO                 = 1; { Progress to the Memo           }
  POV_STAT                 = 2; { Progress to the status caption }
  FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }

var
  CCINetCCForm         : TCCINetCCForm;
  GlobalErrorCode      : Integer;        { Used to pass around error info  }
  GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  ProgressList         : TStringList;    { Used to hold progress text info }
  ProgressFileName     : string;         { Used to hold progress file name }
  ProgressOutputVector : Integer;        { Used to direct progress output  }
  TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  MailPath             : string;         { Used for path to Mail Files     }
  NewsPath             : string;         { Used for path to News Files     }
  WWWPath              : string;         { Used for path to WWW Files      }
  FTPPath              : string;         { Used for path to FTP Files      }
  CurrentPassWordString : string;        { Used to hold login id for anons }
  PassWordControlVector : Integer;       { Used to hold display of pw vect }
  CurrentRealPWString   : string;        { Used to hold a real password    }
  TheLine ,
  HolderLine ,
  GlobalTextBuffer      : string;
  TheAnonRedialVector ,
  DefaultDownloadVector : Integer;
  LeftoverText          : string;
  LeftoversOnTable      : Boolean;
  FileNameToXFer        : string;

implementation

{$R *.DFM}



{ This procedure reads in the ini file and default path info }
procedure TCCINetCCForm.ReadIniData;
begin
  TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  TheICCIniFile.Free;
end;

{ This procedure writes out default path data to the ini file }
procedure TCCINetCCForm.WriteIniData;
begin
  TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  TheICCIniFile.Free;
end;

{ This procedure scans a line of UNIX-style text for #10's and }
{ outputs them as lines to the memo. It stops at #0.           }
procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : string;
                                 TheMemoToAddTo : TMemo   );
var
  TextLength ,            { Total chars to output         }
  Counter_1    : Integer; { Loop Index                    }
begin
  { Make the target memo visible just in case }
  TheMemoToAddTo.Visible := true;
  { Find total chars to output }
  TextLength := Length( TheTextToAdd );
  { If none then leave }
  if TextLength = 0 then exit;
  { Loop along the string }
  for Counter_1 := 1 to TextLength do
  begin
    { If hit ASCII 10 then assume end of line and output }
    if TheTextToAdd[ Counter_1 ] = #10 then
    begin
      { Use a try loop incase memo fills up }
      try
        { Add the line }
        TheMemoToAddTo.Lines.Add( TheLine );
      except
        { If memo fills up }
        on EOutOfResources do
        begin
          { Clear the old data }
          TheMemoToAddTo.Clear;
          { Output the new }
          TheMemoToAddTo.Lines.Add( TheLine );
        end;
      end;
      { clear the output buffer }
      TheLine := '';
    end
    else
    { Otherwise look for null terminator from Winsock }
    begin
      { If don't hit null terminator then add the char to op buffer }
      if TheTextToAdd[ Counter_1 ] <> #0 then
      begin
        TheLine := TheLine + TheTextToAdd[ Counter_1 ];
      end
      else
      begin
        if TheLine <> '' then
        begin
          { Use a try loop incase memo fills up }
          try
            { Add the line }
            TheMemoToAddTo.Lines.Add( TheLine );
          except
            { If memo fills up }
            on EOutOfResources do
            begin
              { Clear the old data }
              TheMemoToAddTo.Clear;
              { Output the new }
              TheMemoToAddTo.Lines.Add( TheLine );
            end;
          end;
          { clear the output buffer }
          TheLine := '';
        end;
      end;
    end;
  end;
end;

{ This function scans a line of UNIX-style text for #10's and }
{ outputs the first line as its return value,stopping at #0.  }
function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
var
  TheLine      : string;  { Buffer to output current line }
  TextLength ,            { Total chars to output         }
  Counter_1    : Integer; { Loop Index                    }
begin
  { Clear output buffer }
  TheLine := '';
  { Find total chars to output }
  TextLength := Length( TheTextToAdd );
  { If none then leave }
  if TextLength = 0 then
  begin
    { Return nothing }
    Result := '';
    { Leave }
    exit;
  end;
  { Loop along the string }
  for Counter_1 := 1 to TextLength do
  begin
    { If hit ASCII 10 then assume end of line and output }
    if TheTextToAdd[ Counter_1 ] = #10 then
    begin
      { Return first line }
      Result := TheLine;
      { Leave }
      exit;
    end
    else
    { Otherwise look for null terminator from Winsock }
    begin
      { If don't hit null terminator then add the char to op buffer }
      if TheTextToAdd[ Counter_1 ] <> #0 then
      begin
        TheLine := TheLine + TheTextToAdd[ Counter_1 ];
      end
      else break; { Otherwise drop out of the loop }
    end;
  end;
  { If hit #0 before #10 return buffer }
  Result := TheLine;
end;

{ Exit method }
procedure TCCINetCCForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

{ This method adds a line to the progress text stringlist  }
{ If an exception occurs, the list is full, and it is auto }
{ saved to the progress text file name, then cleared.      }
procedure TCCINetCCForm.AddProgressText( WhatText : string );
begin
  { Use a try..except loop to catch list overflows }
  try
    { Try the normal add }
    ProgressList.Add( WhatText );
  except
    { Any list error is assumed to be a list overflow }
    on EListError do
    begin
      { Save the list to the preset file name }
      ProgressList.SaveToFile( ProgressFileName );
      { Clear the list to make more room }
      ProgressList.Clear;
      { And redo the add; any further errors will except normally }
      ProgressList.Add( WhatText );
    end;
    { This might happen too! }
    on EOutOfResources do
    begin
      { Save the list to the preset file name }
      ProgressList.SaveToFile( ProgressFileName );
      { Clear the list to make more room }
      ProgressList.Clear;
      { And redo the add; any further errors will except normally }
      ProgressList.Add( WhatText );
    end;
  end;
end;

{ This method either adds the progress line to the current memo }
{ or puts it in the status caption at normal colors.            }
procedure TCCINetCCForm.ShowProgressText( WhatText : string );
begin
  { Use the POV to determine where to show progress info }
  case ProgressOutputVector of
    POV_MEMO : begin { Output into the memo  }
                 AddNullTermTextToMemo( WhatText , Memo1 );
               end;
    POV_STAT : begin { Output on status line }
                 { Set panel caption font to black }
                 Panel1.Font.Color := clBlack;
                 { Get the first line of text and put in caption }
                 Panel1.Caption := AddNullTermTextToLabel( WhatText );
               end;
  end;
end;

{ This method is identical with SPT except sets status color to red and beeps }
procedure TCCINetCCForm.ShowProgressErrorText( WhatText : string );
begin
  { Do error beep }
  MessageBeep( mb_IconExclamation );
  { Use the POV to determine where to show progress info }
  case ProgressOutputVector of
    POV_MEMO : begin { Output into the memo  }
                 AddNullTermTextToMemo( WhatText , Memo1 );
               end;
    POV_STAT : begin { Output on status line }
                 { Set panel caption font to black }
                 Panel1.Font.Color := clRed;
                 { Get the first line of text and put in caption }
                 Panel1.Caption := AddNullTermTextToLabel( WhatText );
               end;
  end;
end;

{ This is the boilerplate method used to handle Socket errors gracefully }
procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
                                              ErrorCode  : Integer;
                                              TheMessage : string   );
begin
  { Set the global error code flag }
  GlobalErrorCode := ErrorCode;
  { If a timeout error }
  if ErrorCode = WSAETIMEDOUT then
  begin
    { Set the aborted flag }
    GlobalAbortedFlag := True;
    { But clear the error code for graceful handling }
    GlobalErrorCode := 0;
  end
  else
  begin
    { Otherwise set the progress buffer to the error message }
    AddProgressText( TheMessage );
    { And show the progress text as set by option }
    ShowProgressErrorText( TheMessage );
  end;
end;

procedure TCCINetCCForm.FormCreate(Sender: TObject);
begin
  { Create the progress string list }
  ProgressList := TStringList.Create;
  { Create the file name for saving the progress list }
  ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  { Default progress output to status line }
  ProgressOutputVector := POV_STAT;
  { Set password control stuff }
  PasswordControlVector := 2;
  CurrentPasswordString := '[e-mail]';
  CurrentRealPWString := '[e-mail]';
  { Get Ini file Data }
  ReadIniData;
end;

procedure TCCINetCCForm.FormDestroy(Sender: TObject);
begin
  { Free the progress text stringlist if assigned }
  if assigned( ProgressList ) then ProgressList.Free;
  { Save off the Ini data }
  WriteIniData;
end;

procedure TCCINetCCForm.Description1Click(Sender: TObject);
var
  TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  TheData    : string;    { Holder for data                           }
begin
  { Create socket; auto calls WSAStartup }
  TempSocket := TCCSocket.Create( Self );
  { Do parent just for kicks; no longer needed }
  TempSocket.Parent := self;
  { Put in error handler }
  TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  { Display the Description string }
  AddProgressText( TheData + #0 );
  { And show the progress text as set by option }
  ShowProgressText( TheData + #0 );
  { Free the socket; auto calls WSACleanup }
  TempSocket.Free;
end;

procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
var
  TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  TheData    : string;    { Holder for data                           }
begin
  { Create socket; auto calls WSAStartup }
  TempSocket := TCCSocket.Create( Self );
  { Do parent just for kicks; no longer needed }
  TempSocket.Parent := self;
  { Put in error handler }
  TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  { Display the Description string }
  AddProgressText( TheData + #0 );
  { And show the progress text as set by option }
  ShowProgressText( TheData + #0 );
  { Free the socket; auto calls WSACleanup }
  TempSocket.Free;
end;

procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
var
  TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  TheData    : string;    { Holder for data                           }
begin
  { Create socket; auto calls WSAStartup }
  TempSocket := TCCSocket.Create( Self );
  { Do parent just for kicks; no longer needed }
  TempSocket.Parent := self;
  { Put in error handler }
  TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  { Display the Description string }
  AddProgressText( TheData + #0 );
  { And show the progress text as set by option }
  ShowProgressText( TheData + #0 );
  { Free the socket; auto calls WSACleanup }
  TempSocket.Free;
end;

{ This method sets the progress output vector to the memo }
procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
begin
  { Set the vector }
  ProgressOutputVector := POV_MEMO;
  { Keep the menu options consistent }
  ViewInEditWindow1.Checked := true;
  ViewInStatusLine1.Checked := false;
end;

{ This method sets the progress output vector to the status line }
procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
begin
  { Set the vector }
  ProgressOutputVector := POV_STAT;
  { Keep the menus consistent }
  ViewInEditWindow1.Checked := false;
  ViewInStatusLine1.Checked := true;
end;

procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
begin
  { Set up the dialog parameters }
  OpenDialog1.Filename := ProgressFileName;
  OpenDialog1.Title := 'Select Filename for Progress File';
  OpenDialog1.Filter := 'Text Files|*.txt';
  { If the dialog is not cancelled then save and clear }
  if OpenDialog1.Execute then
  begin
    ProgressFileName := OpenDialog1.FileName;
    ProgressList.SaveToFile( ProgressFileName );
    ProgressList.Clear;
  end;
end;

procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
begin
  { Set up info dialog for IP Address getting }
  CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  CCICInfoDlg.Panel4.Visible := false;
  CCICInfoDlg.Panel6.Visible := false;
  CCICInfoDlg.Panel9.Visible := false;
  CCICInfoDlg.Panel8.Visible := false;
  CCICInfoDlg.BitBtn2.Visible := false;
  CCICInfoDlg.Button1.Caption := 'Get IP Address';
  CCICInfoDlg.Button2.Visible := false;
  CCICInfoDlg.Button3.Visible := false;
  CCICInfoDlg.Button4.Visible := false;
  CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  CCICInfoDlg.Panel5.Caption := '           Binary:';
  CCICInfoDlg.Edit1.Text := '';
  CCICInfoDlg.Edit2.Text := '';
  CCICInfoDlg.Edit3.Text := '';
  { Set IP Address Mode }
  CCICInfoDlg.Tag := 1;
  { Show Modally to get the information }
  CCICInfoDlg.ShowModal;
  { Reset the info dialog to default conditions }
  CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  CCICInfoDlg.Panel4.Visible := true;
  CCICInfoDlg.Panel6.Visible := true;
  CCICInfoDlg.Panel9.Visible := true;
  CCICInfoDlg.Panel8.Visible := true;
  CCICInfoDlg.BitBtn2.Visible := true;
  CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  CCICInfoDlg.Button2.Visible := true;
  CCICInfoDlg.Button3.Visible := true;
  CCICInfoDlg.Button4.Visible := true;
  CCICInfoDlg.Panel2.Caption := '             Name:';
  CCICInfoDlg.Panel3.Caption := '    IP Address:';
  CCICInfoDlg.Panel5.Caption := ' User Name:';
  CCICInfoDlg.Edit1.Text := '';
  CCICInfoDlg.Edit2.Text := '';
  CCICInfoDlg.Edit3.Text := '';
end;

procedure TCCINetCCForm.FormResize(Sender: TObject);
begin
  { Use tag vector to determine what to do }
  case Tag of
    { if FTP , make sure two list boxes are same height }
    2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  end;
end;

end.